Amiga Mag HDD Backup/Amiga Mag HDD Backup.zip/Amiga Mag HDD Backup/Alexander.img.bin/Alexander.img/tech 4.1 editorial Archive.sit/Griebling/Listing1

Text File | 1993-06-16 | 14KB | 575 lines

IMPLEMENTATION MODULE ExIntegers;

(*  Some Functions to perform bit manipulation on ExNumbers.
    This module deals with integral ExNumbers in the range
    from -5.9863E51 to 5.9863E51.  Any numbers outside this
    range are represented with the maximum (or minimum)
    ExNumber from this range.
*)

FROM Conversions IMPORT ConvNumToStr, ConvStrToNum;
FROM ExMathLib0  IMPORT xtoi;
FROM ExNumbers   IMPORT ExNumType, ExChgSign, ExMin, ExMax,
                        GetMaxDigits, Ex0, ExNumb, SignType,
                        ExSub, Ex1, ExMult, ExDiv, IsZero,
                        ExTrunc, ExAbs, ExStatus, ExStatusType,
                        GetExpMant, ExDiv10, ExToLongInt,
                        ExFrac, ExAdd, ExNumToStr,
                        ExToLongCard, WriteExNum;
FROM InOut       IMPORT WriteString, WriteLn, WriteLongInt,
                        WriteCard;
FROM Strings     IMPORT InsertSubStr, LengthStr;


CONST
  MaxBase2Bits = 172;    (* ln(9.99E51) / ln(2) *)
  LogicalSize  = MaxBase2Bits DIV 16;
  Left         = FALSE;
  Right        = TRUE;

TYPE
  LogicalType = ARRAY [0..LogicalSize] OF BITSET;
  LogicalProc = PROCEDURE(BITSET, BITSET) : BITSET;
  ExNumbProc  = PROCEDURE(VAR ExNumType, ExNumType, ExNumType);

VAR
  LogZero   : LogicalType; (* All bits cleared or 0  *)
  MaxNumber : ExNumType;   (*  2 ** MaxBase2Bits - 1 *)
  MinNumber : ExNumType;   (* -2 ** MaxBase2Bits + 1 *)
  Two       : ExNumType;   (* The value "2" *)
  Cnt       : CARDINAL;


(*--------------------------------------*)
(* Local bit manipulations functions.   *)

PROCEDURE And (op1, op2 : BITSET) : BITSET;
BEGIN
  RETURN op1 * op2;
END And;

PROCEDURE AndNot (op1, op2 : BITSET) : BITSET;
BEGIN
  RETURN op1 - op2;
END AndNot;

PROCEDURE Or (op1, op2 : BITSET) : BITSET;
BEGIN
  RETURN op1 + op2;
END Or;

PROCEDURE Xor (op1, op2 : BITSET) : BITSET;
BEGIN
  RETURN op1 / op2;
END Xor;


(*--------------------------------------*)
(* Miscellaneous local procedures       *)

PROCEDURE Max (x, y : INTEGER) : INTEGER;
BEGIN
  IF x > y THEN
    RETURN x;
  ELSE
    RETURN y;
  END;
END Max;


PROCEDURE ConstrainExNum (VAR Number : ExNumType);
(* Limit Number to be within MinNumber to MaxNumber and
   eliminate any fractional portions. *)
BEGIN
  ExMin(Number, MaxNumber, Number);
  ExMax(Number, MinNumber, Number);
  ExTrunc(Number);
END ConstrainExNum;


PROCEDURE ExNumToLogical (Numb        : ExNumType;
                          VAR Logical : LogicalType);
VAR
  DivScale : ExNumType;
  Scale    : ExNumType;
  Temp     : ExNumType;
  Temp2    : ExNumType;
  LogCnt   : INTEGER;
BEGIN
  (* Constrain op1, op2 to be within the logical number set *)
  ConstrainExNum(Numb);

  (* translation scaling factor *)
  ExNumb(65536, 0, 0, Scale);
  ExDiv(DivScale, Ex1, Scale);

  (* perform conversion *)
  LogCnt  := 0;
  Logical := LogZero;
  WHILE NOT IsZero(Numb) DO
    ExMult(Temp2, Numb, DivScale);
    ExTrunc(Temp2);
    ExMult(Temp, Temp2, Scale);
    ExSub(Temp, Numb, Temp);
    IF LogCnt > LogicalSize THEN RETURN END;
    Logical[LogCnt] := BITSET(ExToLongInt(Temp));
    Numb := Temp2;
    INC(LogCnt);
  END;
END ExNumToLogical;

PROCEDURE LogicalToExNum (Logical  : LogicalType;
                          VAR Numb : ExNumType);
VAR
  Scale  : ExNumType;
  Temp   : ExNumType;
  LogCnt : INTEGER;
BEGIN
  (* translation scaling factor *)
  ExNumb(65536, 0, 0, Scale);

  (* perform conversion *)
  Numb := Ex0;
  FOR LogCnt := LogicalSize TO 0 BY -1 DO
    ExMult(Numb, Numb, Scale);
    ExNumb(LONGINT(Logical[LogCnt]), 0, 0, Temp);
    ExAdd(Numb, Numb, Temp);
  END;
END LogicalToExNum;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* logical operations on ExNumbers.     *)

PROCEDURE LOp (VAR Result : ExNumType;
               op1        : ExNumType;
               Oper       : LogicalProc;
               op2        : ExNumType);
VAR
  i : CARDINAL;
  Lop1, Lop2 : LogicalType;
BEGIN
  (* Translate to logicals *)
  ExNumToLogical(op1, Lop1);
  ExNumToLogical(op2, Lop2);

  (* Operate on Lop1 and Lop2 one quad at a time *)
  FOR i := 0 TO LogicalSize DO
    Lop2[i] := Oper(Lop1[i], Lop2[i]);
  END;

  (* Translate back the result *)
  LogicalToExNum(Lop2, Result);
END LOp;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* single bit operations on ExNumbers.  *)

PROCEDURE LBit (VAR Result : ExNumType;
                number     : ExNumType;
                Oper       : LogicalProc;
                bitnum     : CARDINAL);
VAR
  Temp : ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  IF bitnum > MaxBase2Bits THEN
    (* no bits are changed *)
    Result := number;
    RETURN;
  END;

  (* calculate 2**bitnum *)
  xtoi(Temp, Two, LONGINT(bitnum));

  (* set the bitnum bit position *)
  LOp(Result, number, Oper, Temp);
END LBit;


(*--------------------------------------*)
(* Local function to extract a bit from *)
(* an ExNumber.                         *)

PROCEDURE BitSet (number : ExNumType;
                  bitnum : CARDINAL) : BOOLEAN;
VAR
  Temp : ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits - 1 *)
  IF bitnum >= MaxBase2Bits THEN
    (* assume FALSE *)
    RETURN FALSE;
  END;

  (* calculate 2**bitnum *)
  xtoi(Temp, Two, LONGINT(bitnum));

  (* extract the bitnum bit *)
  ExAnd(number, number, Temp);

  (* translate to boolean *)
  RETURN NOT IsZero(number);
END BitSet;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* bit shifting operations on ExNumbers.*)

PROCEDURE LShift (VAR Result : ExNumType;
                  number     : ExNumType;
                  ExOper     : ExNumbProc;
                  bits       : CARDINAL);
VAR
  Temp : ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  IF bits > MaxBase2Bits THEN
    (* shifted out of range *)
    Result := Ex0;
    RETURN;
  END;

  (* calculate 2**bits *)
  xtoi(Temp, Two, LONGINT(bits));

  (* shift the number *)
  ExOper(Result, number, Temp);

  (* Constrain number to be within the logical number set *)
  ConstrainExNum(Result);
END LShift;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* bit rotation operations on ExNumbers.*)

PROCEDURE LRotate (VAR Result : ExNumType;
                   number     : ExNumType;
                   Shiftright : BOOLEAN;
                   bits       : CARDINAL);
VAR
  ShiftCnt : CARDINAL;
  SavedBit : BOOLEAN;
  Half     : ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  bits := bits MOD (MaxBase2Bits + 1);
  ExNumb(0, 5, 0, Half);

  FOR ShiftCnt := 1 TO bits DO
    IF Shiftright THEN
      (* save the bit to be shifted *)
      SavedBit := BitSet(number, 0);

      (* shift the number right *)
      ExMult(number, number, Half);
      ExTrunc(number);
      IF SavedBit THEN
        ExSetBit(number, number, MaxBase2Bits-1);
      END;
    ELSE
      (* save the bit to be shifted *)
      SavedBit := BitSet(number, MaxBase2Bits-1);

      (* shift the number left *)
      ExMult(number, number, Two);

      (* restore the saved bit *)
      IF SavedBit THEN
        ExSetBit(number, number, 0);
      END;
    END;

  END;

  (* Constrain number to be within the logical number set *)
  Result := number;
  ConstrainExNum(Result);
END LRotate;


(*--------------------------------------*)
(* Exported procedures.                 *)

PROCEDURE ExAnd (VAR Result : ExNumType;
                op1, op2   : ExNumType);
BEGIN
  LOp(Result, op1, And, op2);
END ExAnd;


PROCEDURE ExOr (VAR Result : ExNumType;
               op1, op2   : ExNumType);
BEGIN
  LOp(Result, op1, Or, op2);
END ExOr;


PROCEDURE ExXor (VAR Result : ExNumType;
                 op1, op2   : ExNumType);
BEGIN
  LOp(Result, op1, Xor, op2);
END ExXor;


PROCEDURE ExIntDiv (VAR Result : ExNumType;
                    op1, op2   : ExNumType);
BEGIN
  (* Constrain inputs to be integers *)
  ConstrainExNum(op1); ConstrainExNum(op2);
  ExDiv(Result, op1, op2);
  ExTrunc(Result);
END ExIntDiv;


PROCEDURE ExMod (VAR Result : ExNumType;
                 op1, op2   : ExNumType);
BEGIN
  (* Result := op1 - (op1 DIV op2) * op2 *)
  ConstrainExNum(op1); ConstrainExNum(op2);
  ExIntDiv(Result, op1, op2);
  ExMult(Result, Result, op2);
  ExSub(Result, op1, Result);
END ExMod;


PROCEDURE ExSetBit (VAR Result : ExNumType;
                    number     : ExNumType;
                    bitnum     : CARDINAL);
BEGIN
  LBit(Result, number, Or, bitnum);
END ExSetBit;


PROCEDURE ExClearBit (VAR Result : ExNumType;
                      number     : ExNumType;
                      bitnum     : CARDINAL);
BEGIN
  LBit(Result, number, AndNot, bitnum);
END ExClearBit;


PROCEDURE ExToggleBit (VAR Result : ExNumType;
                       number     : ExNumType;
                       bitnum     : CARDINAL);
BEGIN
  LBit(Result, number, Xor, bitnum);
END ExToggleBit;


PROCEDURE ExOnesComp (VAR Result : ExNumType;
                      number     : ExNumType);
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);
  IF number.Sign = positive THEN
    (* Subtract from the maximum number *)
    ExSub(Result, MaxNumber, number);
  ELSE
    (* Subtract from the minimum number *)
    ExSub(Result, MinNumber, number);
  END;

  (* Complement the sign bit *)
  ExChgSign(Result);
END ExOnesComp;


PROCEDURE ExShl (VAR Result : ExNumType;
                 number     : ExNumType;
                 numbits    : CARDINAL);
BEGIN
  LShift(Result, number, ExMult, numbits);

  (* Determine the resultant sign *)
  IF BitSet (Result, MaxBase2Bits-1) THEN
    Result.Sign := negative;
  ELSE
    Result.Sign := positive;
  END;
END ExShl;


PROCEDURE ExRol (VAR Result : ExNumType;
                 number     : ExNumType;
                 numbits    : CARDINAL);
BEGIN
  LRotate(Result, number, Left, numbits);
END ExRol;


PROCEDURE ExShr (VAR Result : ExNumType;
                 number     : ExNumType;
                 numbits    : CARDINAL);
BEGIN
  LShift(Result, number, ExDiv, numbits);
  ExAbs(Result);  (* clear the sign *)
END ExShr;


PROCEDURE ExAshr (VAR Result : ExNumType;
                  number     : ExNumType;
                  numbits    : CARDINAL);
VAR
  ShiftCnt : CARDINAL;
  SavedBit : BOOLEAN;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  IF numbits > MaxBase2Bits THEN
    (* shifted out of range *)
    Result := Ex0;
    RETURN;
  END;

  (* set the SavedBit to the current sign *)
  SavedBit := number.Sign = negative;

  (* shift the number *)
  FOR ShiftCnt := 1 TO numbits DO
    (* shift the number right *)
    ExDiv(number, number, Two);

    (* restore the saved bit *)
    IF SavedBit THEN
      ExSetBit(number, number, MaxBase2Bits-1);
    END;
  END;

  (* truncate any fraction *)
  Result := number;
  ExTrunc(Result);
END ExAshr;


PROCEDURE ExRor (VAR Result : ExNumType;
                 number     : ExNumType;
                 numbits    : CARDINAL);
BEGIN
  LRotate(Result, number, Right, numbits);
END ExRor;


(*$S-*)
PROCEDURE StrToExInt(S     : ARRAY OF CHAR;
                     Base  : BaseType;
                     VAR A : ExNumType);
VAR
  EndCnt, InCnt : INTEGER;
  Multiplier    : INTEGER;
  Scale, Temp   : ExNumType;

  PROCEDURE DigitIs() : LONGINT;
  VAR
    Str : ARRAY [0..1] OF CHAR;
    Digits : LONGINT;
  BEGIN
    (* Extract a digit *)
    Str[0] := S[InCnt]; Str[1] := 0C;
    INC(InCnt);

    IF NOT ConvStrToNum(Str, Digits, Base, FALSE) THEN
      ExStatus := IllegalNumber;
      RETURN 0;
    END;
    RETURN Digits;
  END DigitIs;

BEGIN
  A := Ex0;
  InCnt := 0;
  EndCnt := LengthStr(S);
  ExNumb(Base, 0, 0, Scale);

  (* skip leading blanks *)
  WHILE (InCnt < EndCnt) & (S[InCnt] = ' ') DO INC(InCnt) END;

  WHILE (InCnt < EndCnt) & (ExStatus # IllegalNumber) DO
    ExNumb(DigitIs(), 0, 0, Temp);
    ExMult(A, A, Scale);
    ExAdd(A, A, Temp);
  END;
END StrToExInt;


PROCEDURE ExIntToStr(A     : ExNumType;
                     Base  : BaseType;
                     VAR S : ARRAY OF CHAR);
VAR
  InCnt : INTEGER;
  InvScale, Scale, Temp, Temp2 : ExNumType;

  PROCEDURE PutDigits(Numb : LONGCARD);
  VAR
    Str : ARRAY [0..80] OF CHAR;
    Ok  : BOOLEAN;
  BEGIN
    Ok := ConvNumToStr(Str, Numb, Base, FALSE, 4, '0');
    InsertSubStr(S, Str, 0);
  END PutDigits;

BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(A);

  S := "";
  InCnt := 0;
  ExNumb(Base, 0, 0, Scale);
  xtoi(Scale, Scale, 4);
  ExDiv(InvScale, Ex1, Scale);

  (* translate number to a string *)
  REPEAT
    (* Temp := A MOD Scale *)
    ExMult(Temp2, A, InvScale);
    ExTrunc(Temp2);
    ExMult(Temp, Temp2, Scale);
    ExSub(Temp, A, Temp);

    (* Translate to character *)
    PutDigits(ExToLongCard(Temp));

    (* Reduce A by scaling factor *)
    A := Temp2;
  UNTIL IsZero(A);
END ExIntToStr;


BEGIN
  (* create the number 2 *)
  ExNumb(2, 0, 0, Two);

  (* Initialize the maximum number *)
  xtoi(MaxNumber, Two, MaxBase2Bits);
  ExSub(MaxNumber, MaxNumber, Ex1);

  (* Initialize the minimum number *)
  MinNumber := MaxNumber;
  ExChgSign(MinNumber);

  (* Initialize the zero logical *)
  FOR Cnt := 0 TO LogicalSize DO
    LogZero[Cnt] := {};
  END;
END ExIntegers.